00002	C*** ACSHFT(RX)
00005	C***** ROFF,NOZERO,RHORZ
00010	C*** RLOOP, BMX
00020	
00030		SUBROUTINE RLOOP(A,B,N)
00040		DIMENSION A(1),B(1)
00050		DO 1 K=1,N
00060	1	A(K)=B(K)
00070		END
00080	
00100		SUBROUTINE BMX(RA)
00200	C  RA=NUMB. OF TAILS
00300	C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
00400		COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(1)
00500		1 /RINP/R(10,85),VQ(100) /STF/RSTFAC(0/7),RSTJ2
00600		1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND /RNW/RNW
00700		1/LIMIT/LIMIT,ITEM,LL,IS,IX /SC/J,L,MK
00800		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
00900		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
01000		1 /SCX/JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
01100		M=IS-12
01200		RX7=RN(7+M)
01300	C ORIGINAL STEM DIR. AND NUM. OF BEAMS INFO.
01400		DO 1 L=KN,K
01500		B=R(7,L)
01600		JB=B/10
01700		B=B-JB*10
01800	C???	B=AMOD(R(7,L),10.0)
01900		IF(R(8,L).EQ.1000.)B=0
02000	C AVOIDS GRACE NOTES AND NON-NOTES
02100		IF(R(1,L).NE.1)B=0
02200	1	VQ(L)=B
02300		VQ(K+1)=0
02400	C   CLEARS IT FOR ROUTINE AT '3'
02500		JB=KN
02600		RX8=0
02700		JBX=0
02800	C THE ABOVE 2 ARE FOR NEW COMPOSITE BEAM FEATURE 5/78
02900	
03000	6	DIS=0
03100		RB9=0
03200		DO 2 L=JB,K
03300		IF(VQ(L).LE.RA)GO TO 2
03400	C  SKIP IF EQ. TO PRESENT BEAM
03500		RB=VQ(L)
03600		LL=L
03700	4	DO 11 JD=LL,K
03800		VQX = VQ(JD)
03900		IF(VQX.GE.RB)GO TO 20
04000		IF(VQX.EQ.0)GO TO 11
04100	C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
04200	21	B=10.
04300		IF(LL.GT.KN)GO TO 13
04400		GO TO 16
04500	20	JV=JD
04600		IF(VQX.GT.RB)GO TO 21
04700	11	JW=JD
04800		B=20
04900	C  FINDS NEED FOR BEAM TO LEFT 
05000	16	B=B+RA
05100		IF(JBX)GO TO 50
05200	C  FOR NEW COMPOSITE BEAM FEATURE 5/78
05300		JE=RN(7+M)/10.
05400		RN(7+M)=JE*10.+RA
05500		GO TO 51
05600	50	DO 5 JE=1,6
05700	5	RN(JE+IS)=RN(JE+M)
05800		RN(7+IS)=RX7+RB-RA*2.
05900	C  ADDS RIGHT NUM. OF BEAMS
06000	51	IF(LL.NE.JV)GO TO 10
06100		IF(LL.EQ.KN)GO TO 377
06200		IF(LL.NE.K)GO TO 10
06300	377	B=-B
06400	C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
06500		GO TO 8
06600	13	IF(JV.GT.LL)GO TO 14
06700		IF(R(7,LL+1).LT.10)GO TO 15
06800	C NEXT FOR DOT ON FOLLOWING NOTE.
06900		DIS=10.
07000		GO TO 19
07100	15	DIS=20.
07200	C SHORT INNER BEAM TO LEFT OF STEM
07300	19	B=-RA
07400		GO TO 16
07500	14	DIS=30
07600	C  LONG INNER BEAM
07700		JV=-JV
07800		GO TO 16
07900	
08000	C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
08100	10	IF(LL.EQ.KN)GO TO 22
08200		IF(JV.GE.0)GO TO 17
08300		B=R(3,LL)
08400		JV=-JV
08500		LL=JV
08600	22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
08700		VQ(JW)=VQ(JW+1)
08800		JW=JW-1
08900	17	IF(LL.NE.JB)GO TO 18
09000		IF(B.LT.20.)LL=JV
09100	C PUTS BEAMS IN RIGHT PLACE.
09200	18	RC=R(10,LL)
09300		IF(RC.EQ.0)GO TO 23
09400		RB=RNW*RSTJ2
09500		IF(ABS(R(4,LL)).GE.100)RB=RB*.6
09600	C  GET WIDTH OF NOTE(RNW) FOR DISPLACEMENT
09700		IF(RC.EQ.2)RB=-RB
09800		RC=RB
09900	23	RB9=RC+R(3,LL)
10000	C  THIS WILL BE POS.3
10100		DIS=RA+DIS
10200	C  DISPLACES
10300		GO TO 8
10400	2	CONTINUE
10500		RETURN
10600	8	JB=JW+1
10700	C  FINDS SIDE (L,R) FOR PARTIAL BEAM
10800	C  FOR NEW DISPLACEMENT
10900		RN(IS+11)=-1
11000		IF(RB9+DIS.EQ.0)GO TO 31
11100		IF(DIS.LT.10)GO TO 32
11200		IF(DIS.LT.30)GO TO 33
11300	C INNER PARTIAL BEAM IS NEXT
11400		DIS=DIS-30
11500		GO TO 31
11600	32	IF(B.GE.20)GO TO 12
11700		DIS=B-10
11800		B=-1
11900	C  -1 PICKS UP POS OF P3
12000		GO TO 31
12100	12	DIS=B-20
12200		B=RB9
12300		RB9=-1
12400	C  -1 IN P9 WILL PICK UP POS OF P6
12500	C  INNER BEAM ATTACHED TO LFT SIDE.
12600		GO TO 31
12700	33	B=-DIS
12800		DIS=0
12900	31	L=IS
13000		IF(JBX)GO TO 53
13100		L=M
13200		DIS=(RB-RA)*100.+1.
13300	53	IF(RX8.GT.1.)GO TO 52
13400		IF(RB9.NE.0)GO TO 52
13500		IF(RX8.NE.0)GO TO 54
13600		RX8=B
13700		GO TO 52
13800	54	RN(8+M)=-30
13900	C TWO UNATTACHED BEAMS, LEFT AND RIGHT
14000		RX8=1
14100		GO TO 55
14200	52	RN(8+L)=B
14300		RN(9+L)=RB9
14400		RN(10+L)=DIS
14500		IF(JBX)CALL UPDATE(9)
14600	C  ADDED ANOTHER ITEM (PART. BEAM)
14700		JBX=-1
14800		JA=0
14900	55	IF(JB.LE.K)GO TO 6
15000		END
15100	
15200		SUBROUTINE ACSHFT(RX)
15300		COMMON /XRN/RN(1) /STF/RSTFAC(0/7),RSTJ2
15400		1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
15500		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
15600		1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
15700		1 /RINP/R(10,85),VQ(100)
15800		EQUIVALENCE (A,F(1)),(B,F(2)),(X,F(4)),
15900		1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
16000		Z=0
16100		L=K-1
16200		M=L-ABS(RX)
16300		JD=1
16400		RN1=99
16500		Y=-.23
16600		IF(RX.LT.0)GO TO 1
16700		L=M
16800		M=K-1
16900		JD=-1
17000	1	DO 2 N=M,L,JD
17100	C  DOES IT HAVE AN ACCID?
17200		IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
17300		A=0
17400		B=0
17500		IF(N.LT.L)A=R(6,N+1)
17600		IF(N.GT.M)B=R(6,N-1)
17700		IF(RN1.NE.99)GO TO 3
17800	C  IS THIS THE FIRST ACCID?
17900		RN1=R(4,N)
18000		GO TO 6
18100	3	RH=R(4,N)
18200		IF(ABS(RH-RN1).LT.5)GO TO 4
18300		RN1=RH
18400		IF(Y.GT.0)Z=Z+.04
18500	C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
18600		Y=-.23+Z
18700	6	IF(A.EQ.20)GO TO 477
18800		IF(B.NE.20)GO TO 4
18900	477	Y=Z
19000	4	X=0
19100		IF(R(6,N).EQ.20)X=-.24
19200		IF(R(6,N).EQ.10)X=.24
19300		Y=Y+.23
19400		IF(X+Y.LT.1)GO TO 7
19500		RN1=RH
19600		Z=Z+.04
19700		Y=0
19800		IF(A.EQ.20)GO TO 677
19900		IF(B.NE.20)GO TO 577
20000	677	Y=.23
20100	C  SO Y DOESN'T GET >1.
20200	577	Y=Y+Z
20300	7	X=X+Y
20400		IF(ABS(X-.04).LT..01)X=0
20500		IF(X.GE.0)GO TO 5
20600		Y=.23+Z
20700		X=Z
20800	5	R(5,N)=R(5,N)+X*RSTFAC(IFIX(STAFF))
20900	C  SPACING OF ACCI. DEPENDS ON STAFF SIZE FACTOR AT THIS POINT
21000	2	CONTINUE
21100		END
21200	
21300	C SETUP ALLOWS SETING UP RHYTHMS ON DESIGNATED STAFF FOR SPACING ALL OTHERS.
21400		SUBROUTINE SETUP
21500		INTEGER PWDS
21600	  	COMMON /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
21700		1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
21800		1 /DPY/ST(4000),MEDIT,GO /XRN/RN(1)
21900		1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
22000		1 ENDP,RA,RDD,ITB,POSB
22100		DIMENSION RPOS(2,100)
22200		EQUIVALENCE (RPOS,ST(3400))
22300	
22400	C  RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
22500		STUP=-1
22600	C  THIS SENDS INFO TO SUBR. NOTES
22700		IF(SET4.GT.7)RETURN
22800	C  **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
22900		IF(ITEM.EQ.0)RETURN
23000		JX=0
23100		RA=0
23200		DO 9534 K=1,ITEM
23300		L=PWDS(K)
23400	      IF(RN(L+2).NE.SET4)GO TO 9534
23500		RD=RN(L+1)
23600		IF(RD.LT.5)GO TO 5
23700		IF(RD.LT.17)GO TO 9534
23800	5	IF(RD.GT.2)GO TO 6
23900		RC=7
24000		IF(RD.EQ.2)RC=5
24100		IF(RN(L).LT.RC)GO TO 9534
24200		M=9
24300		IF(RD.EQ.2)M=7
24400		RC=RN(L+M)
24500		IF(RC.EQ.0)GO TO 9534
24600	C  FOR OTHER NOTES ON SPACING STAFF.
24700		IF(RC.EQ.4./88.)GO TO 9534
24800	C THESE FOR GRACE NOTES   (1/88 NOTES)
24900		GO TO 7
25000	C  SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
25100	6	IF(RD.NE.3)GO TO 8
25200		IF(RN(L).LT.3)GO TO 7
25300		RC=RN(L+5)
25400		IF(RC.GE.100)GO TO 7
25500		IF(RC.GT.3)GO TO 9534
25600	C  SKIPS IF NOT A REAL CLEF  (+100=MINI CLEF)
25700		GO TO 7
25800	8	IF(RD.NE.4)GO TO 10
25900		IF(RN(L).GT.2)GO TO 9534
26000	C  SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
26100	10	IF(RD.NE.2)GO TO 7
26200		IF(RN(L).LT.5)GO TO 9534
26300		IF(RN(L+7).EQ.0)GO TO 9534
26400	7	JX=JX+1
26500		RPOS(1,JX)=RN(L+3)
26600		IF(RD.GT.2)GO TO 3
26700	C JUMP WHEN TIME VALUES ARE IN P8
26800	C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
26900	277	RA=RA+RC
27000	C  SUM OF RHYTHS
27100		GO TO 77
27200	3	RC=-RD
27300	77	RPOS(2,JX)=RC
27400	C  RC IS RHYTHMIC VALUE OF NOTE.
27500	9534	CONTINUE
27600	C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
27700	C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
27800		IF(RA.EQ.0)RETURN
27900	C  RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF. 
28000	
28100		CALL SORT2(RPOS,JX)
28200		ENDP=200.
28300		IF(RPOS(2,JX))ENDP=RPOS(1,JX)
28400		DO 1 L=1,JX
28500	1	IF(RPOS(2,L).GT.0)GO TO 4
28600	4	RD=RPOS(1,L)
28700		RB=ENDP-RD
28800	C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
28900		RC=RPOS(2,L)
29000		RPOS(2,L)=RD
29100	C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
29200		DO 2 K=L+1,JX
29300		RE=RPOS(2,K)
29400		IF(RE)GO TO 2
29500		RD=RC/RA*RB+RD
29600		RC=RE
29700		RPOS(2,K)=RD
29800	2	CONTINUE
29900	C  1,K=REAL POS.    2,K=AVERAGED POS.
30000	C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
30100		JX=JX+1
30200		RPOS(1,JX)=ENDP
30300		RPOS(2,JX)=ENDP
30400		STUP=0
30500	C  THIS FOR NOTES AND RHYTH
30600		END
30700	
30800		SUBROUTINE TYPE
30900		COMMON/ALF/INP(72),ML /IDEV/IDEV /MKX/KSLA,ISEMI,LESS,IGT
31000		IF(IDEV.NE.5)GO TO 2
31100	1	CALL TYPSTR('TYPE --')
31200		CALL TYPCRL
31300	2	READ(IDEV,2114,END=167)INP
31400		IF(INP(1).EQ.LESS)GO TO 167
31500		IF(INP(1).NE.IGT)RETURN
31600		IDEV=1
31700		GO TO 2
31800	167	IDEV=5
31900		GO TO 1
32000	2114	FORMAT(72A1)
32100	C  FOR 'SCORE' INPUT
32200		END
32300	
32400		SUBROUTINE SLRLEV(RA,RB,NN,C,P6)
32500	C RA=LEFT LEVEL OF SLUR, RB=RIGHT LEVEL, NN=NEG='DIP' UP
32600		COMMON /STF/RSTFAC(8),RSTJ2
32700		X=RA-RB
32800		IF(X.EQ.0)RETURN
32900		C=-7.
33000	C  C=NEG MAKES P8 INTO A -1.
33100		IF(NN.GE.0)GO TO 1
33200		IF(X.GT.0)GO TO 2
33300		RA=RA+7
33400		IF(X.GT.-7.)RA=RB
33500		RETURN
33600	2	RB=RB+7
33700		IF(X.LT.7)RB=RA
33800		RETURN
33900	1	IF(X.LT.0)GO TO 3
34000		RA=RA-7
34100		IF(X.LT.7)RA=RB
34200		GO TO 4
34300	3	RB=RB-7
34400		IF(X.GT.-7.)RB=RA
34500	4	P6=P6-2.3*RSTJ2
34600	C WHEN DIP IS DOWN, SHIFT RIGHT SIDE OF SLUR TO LEFT TO AVOID HITTING STEM.
34700		END
34800	
34900		FUNCTION OUTLIM(I,J)
35000		COMMON R2,JA,CENTR,J2,R3,R4,R5 /XRN/RN(1)
35100		OUTLIM=-1
35200		R=RN(I+J)
35300	     	IF(R.LT.R4)RETURN
35400		IF(R.GT.R5)RETURN
35500		OUTLIM=0 
35600		END
35700		FUNCTION NOTAIL(X)
35800		NOTAIL=0
35900		Z=ABS(X)
36000		IF(Z.LT..56.OR.Z.EQ..75)RETURN
36100		IF(Z.EQ..875.OR.Z.EQ..6)RETURN 
36200		NOTAIL=-1
36300		END
36400	
36500		FUNCTION POSIT(V)
36600		COMMON/RINP/R(10,85),POSNT(0/99)
36700		IF(V)V=-V
36800	C  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
36900		K=V
37000		A=POSNT(K)
37100		POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
37200	C TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
37300		END
37400	            
37500		SUBROUTINE SLEND
37600		INTEGER PWDS
37700		COMMON/XRN/RN(1)  /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
37800		1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM /RMOD/RMODE2,RSET4,IBEAM,
37900		1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
38000		DO 1 K=1,ITEM
38100		L=PWDS(K)
38200	C SLN1:	MOVE 6,PTR(5)	;L=PWDS(K)
38300		IF(RN(L+1).NE.8)GO TO 1
38400	C  FOUND A STAFF
38500		IF(RN(L+2).NE.STAFF)GO TO 1
38600		IF(ITB.LT.0)GO TO 2
38700		POSB=202
38800		IF(RN(L).LT.4)RETURN
38900		POSB=RN(L+6)+2
39000		IF(POSB.EQ.2)POSB=202
39100		RETURN
39200	2	POSB=RN(L+3)-2.3
39300		RETURN
39400	1	CONTINUE
39500		END
39510	
40010	
40020		FUNCTION ROFF(R)
40030	C FOR ROUND OFF
40040		S=.5
40050		IF(R.LT.0)S=-S
40060		ROFF=R+S
40070		END
40080	
40090		SUBROUTINE NOZERO(X)
40100		IF(X.EQ.0)X=1.
40110		END
40120	
40130		SUBROUTINE EXCH(X,Y)
40140		Z=X
40150		X=Y
40160		Y=Z
40170		END
40180	
40190		FUNCTION RHORZ(R)
40200		RHORZ=R*5.96-596.
40210		END
40220	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
40230	
40240		FUNCTION RTLINE(L)
40250		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(1)
40260	C CHECKS TO SEEIF R2 HAS STAFF NUM DESIRED.  (IF >7, ALL STAVES OK)
40270		IF(R2.GT.7)GO TO 1
40280		IF(RN(L+2).NE.R2)GO TO 2
40290	1       RTLINE=0
40300	C RIGHT STAFF
40310		RETURN
40320	2	RTLINE=-1
40330	C WRONG STAFF
40340		END